{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit EmailHelper;

interface

uses Classes, IdSMTP, IdMessage;

const
  DEF_SEND_TIMEOUT = 1000; // Default timeout (in ms) for connection to SMTP server
  DEF_SMTP_PORT_NUM = 25; // Default port number to use for connection to SMTP server
  DEF_MESSAGE_AGENT = '@home media automated email'; // Default agent for outbound messages
  DEF_MESSAGE_SENDER = 'support@athomemedia.co.uk'; // Default sender address

type
  TAHMEmailAttachment = class
  private
    FFilename: String;
    FContents: String;
  protected
    function GetIsVirtualFile: Boolean;
    procedure SaveToFile;
    procedure DeleteFile;
  public
    property Filename: String read FFilename write FFilename;
    property Contents: String read FContents write FContents;
    property IsVirtualFile: Boolean read GetIsVirtualFile;
  end;

  TAHMEmailAttachments = class
  private
    FAttachments: TList;
  protected
    function GetCount: Integer;
    function GetAttachment(Index: Integer): TAHMEmailAttachment;
    procedure PrepareAttachments;
    procedure UnprepareAttachments;
  public
    constructor Create;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Attachments[Index: Integer]: TAHMEmailAttachment read GetAttachment; default;
    procedure AttachFile(Filename: String);
    procedure AttachText(Filename, Contents: String);
  end;

  TAHMEmailHelper = class
  private
    FEmailSender: TIdSMTP;
    FEmailMessage: TIdMessage;
    FMailHost: String;
    FMailPort: Integer;
    FMsgAgent: String;
    FMsgSender: String;
    FMsgRecipient: String;
    FError: String;
  protected
    procedure ConfigureMessage;
  public
    constructor Create;
    destructor Destroy; override;
    property MailHost: String read FMailHost write FMailHost;
    property MailPort: Integer read FMailPort write FMailPort;
    property MessageAgent: String read FMsgAgent write FMsgAgent;
    property MessageSender: String read FMsgSender write FMsgSender;
    property MessageRecipient: String read FMsgRecipient write FMsgRecipient;
    property LastError: String read FError;
    function SendMail(Subject, MessageText: String): Boolean; overload;
    function SendMail(Subject, MessageText: String; Attachments: TAHMEmailAttachments): Boolean; overload;
  end;

implementation

uses SysUtils, Utilities;

//----------------------------------------------------------------------------//

function TAHMEmailAttachment.GetIsVirtualFile: Boolean;
begin
  Result := FContents <> '';
end;

procedure TAHMEmailAttachment.SaveToFile;
begin
  with TStringList.Create do
  try
    Text := FContents;
    SaveToFile(FFilename);
  finally
    Free;
  end;
end;

procedure TAHMEmailAttachment.DeleteFile;
begin
  SysUtils.DeleteFile(FFilename);
end;

//----------------------------------------------------------------------------//

constructor TAHMEmailAttachments.Create;
begin
  inherited Create;

  FAttachments := TList.Create;
end;

destructor TAHMEmailAttachments.Destroy;
var
  i: Integer;
begin
  for i := 0 to Pred(FAttachments.Count) do
    TAHMEmailAttachment(FAttachments[i]).Free;

  inherited Destroy;
end;

function TAHMEmailAttachments.GetCount: Integer;
begin
  Result := FAttachments.Count;
end;

function TAHMEmailAttachments.GetAttachment(Index: Integer): TAHMEmailAttachment;
begin
  if (Index >= 0) and (Index < FAttachments.Count) then
    Result := TAHMEmailAttachment(FAttachments[Index])
  else
    Result := nil;
end;

procedure TAHMEmailAttachments.PrepareAttachments;
var
  i: Integer;
begin
  for i := 0 to Pred(FAttachments.Count) do
    with TAHMEmailAttachment(FAttachments[i]) do
      if IsVirtualFile then SaveToFile;
end;

procedure TAHMEmailAttachments.UnprepareAttachments;
var
  i: Integer;
begin
  for i := 0 to Pred(FAttachments.Count) do
    with TAHMEmailAttachment(FAttachments[i]) do
      if IsVirtualFile then DeleteFile;
end;

procedure TAHMEmailAttachments.AttachFile(Filename: String);
begin
  // Defer to method below
  AttachText(Filename, '');
end;

procedure TAHMEmailAttachments.AttachText(Filename, Contents: String);
var
  Attachment: TAHMEmailAttachment;
begin
  Attachment := TAHMEmailAttachment.Create;
  Attachment.Contents := Contents;

  // Text attachments will need to be persisted as a temp file first
  if Attachment.IsVirtualFile then
    Attachment.Filename := ApplicationTempPath + Filename
  else
    Attachment.Filename := Filename;

  FAttachments.Add(Attachment);
end;

//----------------------------------------------------------------------------//

constructor TAHMEmailHelper.Create;
begin
  inherited Create;

  // Create Indy SMTP object to send mail
  FEmailSender := TIdSMTP.Create(nil);

  // Set default connection properties
  FMailHost := 'localhost';
  FMailPort := DEF_SMTP_PORT_NUM;

  // Set default message properties
  FMsgAgent := DEF_MESSAGE_AGENT;
  FMsgSender := DEF_MESSAGE_SENDER;
  FMsgRecipient := DEF_MESSAGE_SENDER;
end;

destructor TAHMEmailHelper.Destroy;
begin
  FEmailMessage.Free;
  FEmailSender.Free;

  inherited Destroy;
end;

procedure TAHMEmailHelper.ConfigureMessage;
begin
  FreeAndNil(FEmailMessage);

  // Create and configure message object
  FEmailMessage := TIdMessage.Create(nil);
  FEmailMessage.From.Address := FMsgSender;
  FEmailMessage.Recipients.Add.Address := FMsgRecipient;
end;

function TAHMEmailHelper.SendMail(Subject, MessageText: String): Boolean;
begin
  // Use method below without attachments
  Result := SendMail(Subject, MessageText, nil);
end;

function TAHMEmailHelper.SendMail(Subject, MessageText: String; Attachments: TAHMEmailAttachments): Boolean;
var
  i: Integer;
begin
  // Set default result - message not sent
  Result := False;
  FError := '';

  // Configure smtp server connection
  FEmailSender.Host := FMailHost;
  FEmailSender.Port := FMailPort;
  FEmailSender.MailAgent := FMsgAgent;

  // Create and configure message object
  ConfigureMessage;
  FEmailMessage.Subject := Subject;
  FEmailMessage.Body.Text := MessageText;

  // Include attachments if required
  if Assigned(Attachments) then
  begin
    Attachments.PrepareAttachments;
    for i := 0 to Pred(Attachments.Count) do
      TIdAttachment.Create(FEmailMessage.MessageParts, Attachments[i].Filename);
  end;

  // Attempt to connect to SMTP server and send mail
  try
    try
      FEmailSender.Connect(DEF_SEND_TIMEOUT);
      FEmailSender.Send(FEMailMessage);

      // Success
      Result := True;
    except
      on E:Exception do FError := E.Message;
    end;
  finally
    if FEmailSender.Connected then FEmailSender.Disconnect;
  end;

  // Remove temporary attachment files
  if Assigned(Attachments) then Attachments.UnprepareAttachments;
end;





end.
